home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / PREVIEW / CLP2DLFI / WABOUTBX.PAS < prev    next >
Pascal/Delphi Source File  |  1995-11-10  |  7KB  |  246 lines
  1. unit wAboutbx;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls;
  8.  
  9. type
  10.   TSetupBox = class(TForm)
  11.     ListBox1: TListBox;
  12.     Button1: TButton;
  13.     Button2: TButton;
  14.     Label1: TLabel;
  15.     wname: TEdit;
  16.     atpds: TCheckBox;
  17.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  18.     procedure Button1Click(Sender: TObject);
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure FormActivate(Sender: TObject);
  21.     procedure Button2Click(Sender: TObject);
  22.     procedure wnameKeyPress(Sender: TObject; var Key: Char);
  23.     procedure atpdsKeyPress(Sender: TObject; var Key: Char);
  24.   private
  25.     { Private declarations }
  26.         procedure Refresh;
  27.         function  TypeName(ltype:string):string;
  28.   public
  29.     { Public declarations }
  30.   end;
  31.  
  32. var
  33.   SetupBox: TSetupBox;
  34.  
  35. implementation
  36.  
  37. {$R *.DFM}
  38.  
  39. uses dbfserver, CommonCode, wPreview;
  40.  
  41. procedure TSetupBox.FormClose(Sender: TObject; var Action: TCloseAction);
  42. begin
  43.   Gen.ReleaseWin(self);
  44.   if (pin('511045',Gen.Station)) or (pin('00012',Gen.Station))
  45.   then begin
  46.     gen.User:=wname.text+' ';
  47.     Gen.AtPDS:=atpds.checked;
  48.     gen.SetAccess;
  49.   end;
  50.   action:=cafree;
  51. end;
  52.  
  53. procedure TSetupBox.Button1Click(Sender: TObject);
  54. begin
  55.   close;
  56. end;
  57.  
  58. procedure TSetupBox.FormCreate(Sender: TObject);
  59. begin
  60.   left:=0;
  61.   top:=0;
  62.   width:=550;
  63.   height:=410;
  64.     centerhoriz(self);
  65.   Gen.AddWin('System Status',self);
  66.   if (pin('511045',Gen.Station)) or (pin('00012',Gen.Station))
  67.   then begin
  68.     wname.text:=trim(gen.User);
  69.     wname.visible:=true;
  70.     atpds.checked:=Gen.AtPDS;
  71.     atpds.visible:=true;
  72.     label1.visible:=true;
  73.     button2.visible:=true;
  74.   end;
  75. end;
  76.  
  77. function TSetupBox.TypeName(ltype:string):string;
  78. begin
  79.   { ltype codes: "W"-Window open,   see comcode.pas: FlagOn()
  80.                                "R"-Routcard
  81.                                  "J"-Job Setup Change
  82.                    "I"-In-process inspect.
  83.                    "F"-Final inspect.
  84.                    "S"-Shipper
  85.                  "Q"-Shipper Request   }
  86.     result:='';
  87.   if ltype='W' then result:='(Window Open)';
  88.   if ltype='R' then result:='(Route Card)';
  89.   if ltype='J' then result:='(Job)';
  90.   if ltype='I' then result:='(In-Process)';
  91.   if ltype='F' then result:='(Final Insp.)';
  92.   if ltype='S' then result:='(Shipper)';
  93.   if ltype='Q' then result:='(Shipper Request)';
  94.   result:=padr(result,18);
  95. end;
  96.  
  97. procedure TSetupBox.Refresh;
  98. var ii,jj:integer;
  99.     tt:string;
  100. begin
  101.   listbox1.clear;
  102.   with listbox1 do begin
  103.     items.add('    Login Name: '+gen.user+' ('+gen.empnum+')');
  104.     items.add('     Station #: '+gen.station);
  105.     if not Gen.AtPDS then items.add('Running At:  Precision Gage');
  106.     items.add('Main Directory: '+upper(jcpath('*')));
  107.     items.add('  Memory Total: '+ltrim(ltransform(memavail,'99,999,999'))+
  108.       ', Largest Block: '+ltrim(ltransform(Maxavail,'99,999,999')));
  109.     items.add('    EXE Source: '+Gen.ExeSource);
  110.     items.add('   CDX Version: '+RocketVersion);
  111.     items.add('');
  112.     if not gen.CanBrowse then begin
  113.       if Gen.CanModifyCnt=0 then items.add('Can''t Browse Any Files')
  114.       else begin
  115.         with Gen do begin
  116.           if CanModifyCnt>0 then begin
  117.             items.add('Can Browse Following Files Only');
  118.             items.add(replicate('-',31));
  119.             for ii:=1 to CanModifyCnt do items.add('   '+CanModifyList[ii]);
  120.           end else items.add('Can''t Modify Any Files During Browse');
  121.         end;
  122.       end;
  123.     end else begin
  124.       if gen.CanBrowseModify then
  125.         items.add('Can Modify All Files During Browse')
  126.       else begin
  127.         with Gen do begin
  128.           if CanModifyCnt>0 then begin
  129.             items.add('Can Modify Following Files During Browse');
  130.             items.add(replicate('-',40));
  131.             for ii:=1 to CanModifyCnt do items.add('   '+CanModifyList[ii]);
  132.           end else items.add('Can''t Modify Any Files During Browse');
  133.         end;
  134.       end;
  135.     end;
  136.     items.add('');
  137.     with lp.LptPrinters[lp.curDest] do begin
  138.         items.add('Active Printer: '+
  139.             prName+' on '+PrPort+iifs(not empty(queue),'('+queue+')',''));
  140.     end;
  141.     items.add('');
  142.     items.add('Other Possible Printers');
  143.     items.add(replicate('-',23));
  144.     items.add('');
  145.     for ii:=1 to lp.PrnCnt do begin
  146.           DoEvents2;
  147.       with lp.LptPrinters[ii] do begin
  148.         if ii<>lp.CurDest then begin
  149.             tt:='   '+prName+' on '+PrPort+
  150.             iifs(not empty(queue),'('+queue+')','');
  151.                 items.add(tt);
  152.         end;
  153.       end;
  154.     end;
  155.     items.add('');
  156.     items.add('Currently Formatting Reports');
  157.     items.add(replicate('-',28));
  158.     items.add('');
  159.     for ii:=1 to lp.PrnCnt do begin
  160.           DoEvents2;
  161.             if not empty(CurPrinting[ii]) then items.add('   '+CurPrinting[ii]);
  162.         end;
  163.     items.add('');
  164.     items.add('Active Windows');
  165.     items.add(replicate('-',14));
  166.     items.add('');
  167.     with Gen do begin
  168.       if MiscWinCnt>0 then begin
  169.         for ii:=1 to MiscWinCnt do items.add('   '+MiscWinList[ii].wClass);
  170.       end;
  171.     end;
  172.     items.add('');
  173.     items.add('Windows And Data In Use');
  174.     items.add(replicate('-',23));
  175.     items.add('');
  176.     with Gen.Multilok do begin
  177.       GoTop;
  178.       while not Gen.Multilok.Eof do begin
  179.         DoEvents2;
  180.         if not empty(s('lock_id')) then begin
  181.           tt:='   '+s('lock_id')+' '+typename(st('lock_type'));
  182.           if d('dated')>0 then begin
  183.             tt:=tt+' '+datehyph(d('dated'))+'  '+s('attime');
  184.           end;
  185.           if pin(':',st('lock_id')) then begin
  186.             if pin(upper(trim(Gen.User)),s('lock_id')) then tt:='';
  187.           end;
  188.           if not empty(tt) then items.add(tt);
  189.         end;
  190.         Skip;
  191.       end;
  192.     end;
  193.     items.add('');
  194.     items.add('Databases Open');
  195.     items.add(replicate('-',14));
  196.     items.add('');
  197.     jj:=0;
  198.     for ii:=1 to 120 do begin
  199.           DoEvents2;
  200.       tt:=dbSelectArea(ii);
  201.       if not empty(tt) then begin
  202.               items.add('   Area '+transform(ii,'999')+'  '+padr(tt,15)+DBFname[ii])
  203.       end else begin
  204.         pp(jj); { exit after finding 10 empty areas }
  205.         if jj>10 then break;
  206.       end;
  207.     end;
  208.     if Gen.DebugCnt>0 then begin
  209.         items.add('');
  210.       for ii:=1 to Gen.DebugCnt do begin
  211.         items.add(Gen.DebugList[ii]);
  212.       end;
  213.       Gen.DebugCnt:=0;
  214.     end;
  215.   end;
  216. end;
  217.  
  218. procedure TSetupBox.FormActivate(Sender: TObject);
  219. begin
  220.   Refresh;
  221. end;
  222.  
  223. procedure TSetupBox.Button2Click(Sender: TObject);
  224. begin
  225.   Refresh;
  226. end;
  227.  
  228. procedure TSetupBox.wnameKeyPress(Sender: TObject; var Key: Char);
  229. begin
  230.   if GetRet(key) then begin
  231.     Gen.User:=wname.text+' ';
  232.     Gen.SetAccess;
  233.     Refresh;
  234.   end;
  235. end;
  236.  
  237. procedure TSetupBox.atpdsKeyPress(Sender: TObject; var Key: Char);
  238. begin
  239.   if GetRet(key) then begin
  240.     Gen.AtPDS:=atpds.checked;
  241.     Refresh;
  242.   end;
  243. end;
  244.  
  245. end.
  246.